home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1999 January / PC Plus Super CD No55a (PCP-147A-1-99) (Disc 1) (1998).iso / linux / developers / visualtcl / windows / vtcl / lib / tree.tcl < prev    next >
Encoding:
Text File  |  1997-09-02  |  6.7 KB  |  188 lines
  1. ##############################################################################
  2. # $Id: tree.tcl,v 1.7 1997/09/03 05:43:35 stewart Exp $
  3. #
  4. # tree.tcl - widget tree browser and associated procedures
  5. #
  6. # Copyright (C) 1996-1997 Stewart Allen
  7. #
  8. # This program is free software; you can redistribute it and/or
  9. # modify it under the terms of the GNU General Public License
  10. # as published by the Free Software Foundation; either version 2
  11. # of the License, or (at your option) any later version.
  12. #
  13. # This program is distributed in the hope that it will be useful,
  14. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. # GNU General Public License for more details.
  17. #
  18. # You should have received a copy of the GNU General Public License
  19. # along with this program; if not, write to the Free Software
  20. # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22. ##############################################################################
  23. #
  24.  
  25. proc vTcl:show_wtree {} {
  26.     global vTcl
  27.     Window show .vTcl.tree
  28. }
  29.  
  30. proc vTcl:clear_wtree {} {
  31.     set b .vTcl.tree.fra4.can8
  32.     foreach i [winfo children $b] {
  33.         destroy $i
  34.     }
  35.     $b delete TEXT LINE
  36.     $b configure -scrollregion "0 0 0 0"
  37. }
  38.  
  39. proc vTcl:init_wtree {} {
  40.     global vTcl
  41.     vTcl:destroy_handles
  42.     vTcl:clear_wtree
  43.     set b .vTcl.tree.fra4.can8
  44.     set y 10
  45.     set tree [vTcl:list_widget_tree .]
  46.     foreach i $tree {
  47.         if {$i == "."} {
  48.             set depth 1
  49.         } else {
  50.             set depth [llength [split $i "."]]
  51.         }
  52.         set x [expr $depth * 30 - 15]
  53.         set x2 [expr $x + 40]
  54.         set y2 [expr $y + 15]
  55.         set j [vTcl:rename $i]
  56.         if {$i == "."} {
  57.             set c toplevel
  58.         } else {
  59.             set c [vTcl:get_class $i 1]
  60.             if {$c == "scrollbar" || $c == "scale"} {
  61.                 append c "_[string index [$i cget -orient] 0]"
  62.             }
  63.         }
  64.         if {![winfo exists $b.$j]} {
  65.             set l($depth) [llength [vTcl:get_children $i]]
  66.             if {$i == "."} {
  67.                 incr l($depth) -1
  68.             }
  69.             if {$depth > 1} {
  70.                 incr l([expr $depth - 1]) -1
  71.             }
  72.             button $b.$j -image ctl_$c -command "
  73.                 vTcl:show $i
  74.                 vTcl:active_widget $i
  75.             "
  76.             vTcl:set_balloon $b.$j $i
  77.             $b create window $x $y -window $b.$j -anchor nw -tags $b.$j
  78.             switch $c {
  79.                 toplevel {set t [wm title $i]}
  80.                 label      -
  81.                 button     -
  82.                 menubutton {set t [$i cget -text]}
  83.                 default    {set t ""}
  84.             }
  85.             $b create text $x2 $y2 -text $t -anchor w -tags TEXT
  86.             set d2 [expr $depth - 1]
  87.             for {set k 1} {$k <= $d2} {incr k} {
  88.                 if {$depth > 1} {
  89.                     set xx2 [expr $k * 30 + 15]
  90.                     set xx1 [expr $k * 30]
  91.                     set yy1 [expr $y + 30]
  92.                     set yy2 [expr $y + 30 - 15]
  93.                     if {$k == $d2} {
  94.                         if {$l($k) > 0} {
  95.                             $b create line $xx1 $y $xx1 $yy1 -tags LINE
  96.                             $b create line $xx1 $yy2 $xx2 $yy2 -tags LINE
  97.                         } else {
  98.                             $b create line $xx1 $y $xx1 $yy2 -tags LINE
  99.                             $b create line $xx1 $yy2 $xx2 $yy2 -tags LINE
  100.                         }
  101.                     } elseif {$l($k) > 0} {
  102.                         $b create line $xx1 $y $xx1 $yy1 -tags LINE
  103.                     }
  104.                 }
  105.             }
  106.         } else {
  107.             $b coords $b.$j $x $y
  108.         }
  109.         incr y 30
  110.     }
  111.     $b configure -scrollregion "0 0 [expr $x + 200] $y"
  112. }
  113.  
  114. proc vTclWindow.vTcl.tree {args} {
  115.     global vTcl
  116.     set base .vTcl.tree
  117.     if {[winfo exists .vTcl.tree]} {
  118.         wm deiconify .vTcl.tree; return
  119.     }
  120.     toplevel .vTcl.tree -class vTcl
  121.     wm transient .vTcl.tree .vTcl
  122.     wm focusmodel .vTcl.tree passive
  123.     wm geometry .vTcl.tree 296x243+75+142
  124.     wm maxsize .vTcl.tree 1137 870
  125.     wm minsize .vTcl.tree 1 1
  126.     wm overrideredirect .vTcl.tree 0
  127.     wm resizable .vTcl.tree 1 1
  128.     wm deiconify .vTcl.tree
  129.     wm title .vTcl.tree "Widget Tree"
  130.     frame .vTcl.tree.fra4 \
  131.         -height 30 -width 30 
  132.     pack .vTcl.tree.fra4 \
  133.         -in .vTcl.tree -anchor center -expand 1 -fill both -ipadx 0 -ipady 0 \
  134.         -padx 0 -pady 0 -side top 
  135.     canvas .vTcl.tree.fra4.can8 \
  136.         -borderwidth 2 -height 0 -highlightthickness 0 -relief ridge \
  137.         -scrollregion {0 0 0 0} -width 0 \
  138.         -xscrollcommand {.vTcl.tree.fra6.scr7 set} \
  139.         -yscrollcommand {.vTcl.tree.fra4.scr9 set} 
  140.     pack .vTcl.tree.fra4.can8 \
  141.         -in .vTcl.tree.fra4 -anchor center -expand 1 -fill both -ipadx 0 \
  142.         -ipady 0 -padx 2 -pady 2 -side left 
  143.     scrollbar .vTcl.tree.fra4.scr9 \
  144.         -borderwidth 1 -command {.vTcl.tree.fra4.can8 yview} \
  145.         -highlightthickness 0
  146.     pack .vTcl.tree.fra4.scr9 \
  147.         -in .vTcl.tree.fra4 -anchor center -expand 0 -fill y -ipadx 0 \
  148.         -ipady 0 -padx 0 -pady 2 -side right 
  149.     frame .vTcl.tree.fra6 \
  150.         -height 30 -width 30 
  151.     pack .vTcl.tree.fra6 \
  152.         -in .vTcl.tree -anchor center -expand 0 -fill x -ipadx 0 -ipady 0 \
  153.         -padx 2 -pady 0 -side top 
  154.     scrollbar .vTcl.tree.fra6.scr7 \
  155.         -borderwidth 1 -command {.vTcl.tree.fra4.can8 xview} \
  156.         -highlightthickness 0 -orient horizontal -width 10 
  157.     pack .vTcl.tree.fra6.scr7 \
  158.         -in .vTcl.tree.fra6 -anchor center -expand 1 -fill both -ipadx 0 \
  159.         -ipady 0 -padx 2 -pady 0 -side left 
  160.     frame .vTcl.tree.fra6.fra10 \
  161.         -borderwidth 1 -height 12 -relief raised -width 12 
  162.     pack .vTcl.tree.fra6.fra10 \
  163.         -in .vTcl.tree.fra6 -anchor center -expand 0 -fill none -ipadx 0 \
  164.         -ipady 0 -padx 0 -pady 0 -side right 
  165.     frame .vTcl.tree.fra11 \
  166.         -borderwidth 1 -height 30 -relief sunken -width 30 
  167.     pack .vTcl.tree.fra11 \
  168.         -in .vTcl.tree -anchor center -expand 0 -fill both -ipadx 0 -ipady 0 \
  169.         -padx 2 -pady 2 -side top 
  170.     button .vTcl.tree.fra11.but3 \
  171.         -command vTcl:init_wtree \
  172.         -highlightthickness 0 -padx 5 -pady 2 -text Reload -width 5 
  173.     pack .vTcl.tree.fra11.but3 \
  174.         -in .vTcl.tree.fra11 -anchor center -expand 1 -fill both -ipadx 0 \
  175.         -ipady 0 -padx 2 -pady 2 -side left 
  176.     button .vTcl.tree.fra11.but1 \
  177.         -command {destroy .vTcl.tree} \
  178.         -highlightthickness 0 -padx 5 -pady 2 -text Done -width 5 
  179.     pack .vTcl.tree.fra11.but1 \
  180.         -in .vTcl.tree.fra11 -anchor center -expand 1 -fill both -ipadx 0 \
  181.         -ipady 0 -padx 2 -pady 2 -side left 
  182.  
  183.     catch {wm geometry .vTcl.tree $vTcl(geometry,.vTcl.tree)}
  184.     vTcl:init_wtree
  185.     vTcl:setup_vTcl:bind .vTcl.tree
  186. }
  187.  
  188.